home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / Bonus / DBaldwin / htmllite.exe / demo_src / FONTDLGL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-06-24  |  5.0 KB  |  196 lines
  1. unit FontDlgL;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, ColorGrd, HTMLLite, Spin;
  8.  
  9. type
  10.   TFontForm = class(TForm)
  11.     FontListBox: TListBox;
  12.     FontColorGrid: TColorGrid;
  13.     HotSpotColorGrid: TColorGrid;
  14.     BackListBox: TListBox;
  15.     OKButton: TButton;
  16.     Cancel: TButton;
  17.     ResetButton: TButton;
  18.     FontSizeEdit: TSpinEdit;
  19.     Label1: TLabel;
  20.     Label2: TLabel;
  21.     Label3: TLabel;
  22.     Label4: TLabel;
  23.     Label5: TLabel;
  24.     FontViewer: ThtmlLite;
  25.     procedure FormCreate(Sender: TObject);
  26.     procedure FormShow(Sender: TObject);
  27.     procedure ResetButtonClick(Sender: TObject);
  28.     procedure HotSpotColorGridChange(Sender: TObject);
  29.     procedure FontColorGridChange(Sender: TObject);
  30.     procedure ListBoxClicks(Sender: TObject);
  31.   private
  32.     { Private declarations }
  33.     FFontColor: TColor;
  34.     FHotSpotColor: TColor;
  35.     FFontSize: integer;
  36.     InitialFontName: string;
  37.     InitialFontSize: integer;
  38.     InitialFontColor: TColor;
  39.     InitialHotSpotColor: TColor;
  40.     InitialBackground: TColor;
  41.     procedure AddItem(const Value: string);
  42.     function GetFontName: TFontName;
  43.     procedure SetFontName(Value: TFontName);
  44.     function GetBackground: TColor;
  45.     procedure SetBackground(Value: TColor);
  46.     procedure SetFontColor(Value: TColor);
  47.     procedure SetHotSpotColor(Value: TColor);
  48.     procedure SetFontSize(Value: integer);
  49.   public
  50.     { Public declarations }
  51.     property FontName: TFontName read GetFontName write SetFontName;
  52.     property Background: TColor read GetBackground write SetBackground;
  53.     property FontColor: TColor read FFontColor write SetFontColor;
  54.     property FontSize: integer read FFontSize write SetFontSize;
  55.     property HotSpotColor: TColor read FHotSpotColor write SetHotSpotColor;
  56.   end;
  57.  
  58. var
  59.   FontForm: TFontForm;
  60.  
  61. implementation
  62.  
  63. {$R *.DFM}
  64. const
  65.   ViewText: string =
  66.      '<center><h1>Heading</h1></center>'+
  67.      '<ul>Some normal text.'+
  68.      '<li><a href=NoWhere>HotSpot Item</a>'+
  69.      '<li><b>Bold Text</b>'+
  70.      '<li><i>Italicized Text</i>'+
  71.      '<li><code>Code Text</code>'+
  72.      '</ul> '+
  73.      '<hr>';
  74.  
  75. procedure TFontForm.FormCreate(Sender: TObject);
  76. begin
  77. FontListBox.Items := Screen.Fonts;
  78. GetColorValues(AddItem);
  79. FontViewer.LoadFromBuffer(@ViewText[1], Length(ViewText));
  80. end;
  81.  
  82. procedure TFontForm.AddItem(const Value: string);
  83. var
  84.   Color: TColor;
  85. begin
  86. Color := StringToColor(Value);
  87. if (Color >= 0) or (Color = -16) or (Color = -6) or (Color = -2) then
  88.   BackListBox.Items.Add(Value);
  89. end;
  90.  
  91. function TFontForm.GetFontName: TFontName;
  92. begin
  93. try
  94.   Result := FontListBox.Items[FontListBox.ItemIndex];
  95. except
  96.   Result := 'System';   {in case nothing hilited}
  97.   end;
  98. end;
  99.  
  100. procedure TFontForm.SetFontName(Value: TFontName);
  101. var
  102.   I: integer;
  103. begin
  104. I := FontListBox.Items.IndexOf(Value);
  105. if I < 0 then
  106.   I := FontListBox.Items.IndexOf('System');
  107. FontListBox.ItemIndex := I;
  108. FontViewer.DefFontName := Value;
  109. end;
  110.  
  111. function TFontForm.GetBackground: TColor;
  112. begin
  113. try
  114.   Result := StringToColor(BackListBox.Items[BackListBox.ItemIndex]);
  115. except
  116.   Result := clBtnFace;
  117.   end;
  118. end;
  119.  
  120. procedure TFontForm.SetBackground(Value: TColor);
  121. var
  122.   I: integer;
  123.   S: string[80];
  124. begin
  125. S := ColorToString(Value);
  126. I := BackListBox.Items.IndexOf(S);
  127. if I < 0 then
  128.   begin
  129.   BackListBox.Items.Add(S);
  130.   I := BackListBox.Items.IndexOf(S);
  131.   end;
  132. BackListBox.ItemIndex := I;
  133. FontViewer.DefBackground := Value;
  134. end;
  135.  
  136. procedure TFontForm.SetFontSize(Value: integer);
  137. begin
  138. FontViewer.DefFontSize := Value;
  139. FFontSize := Value;
  140. FontSizeEdit.Value := Value;
  141. end;
  142.  
  143. procedure TFontForm.SetFontColor(Value: TColor);
  144. begin
  145. FontViewer.DefFontColor := Value;
  146. FFontColor := Value;
  147. FontColorGrid.ForegroundEnabled := False;
  148. end;
  149.  
  150. procedure TFontForm.SetHotSpotColor(Value: TColor);
  151. begin
  152. FontViewer.DefHotSpotColor := Value;
  153. FHotSpotColor := Value;
  154. HotSpotColorGrid.ForegroundEnabled := False;
  155. end;
  156.  
  157. procedure TFontForm.FormShow(Sender: TObject);
  158. begin
  159. InitialFontName := GetFontName;
  160. InitialFontColor := FFontColor;
  161. InitialHotSpotColor := FHotSpotColor;
  162. InitialBackground := GetBackground;
  163. InitialFontSize := FFontSize;
  164. end;
  165.  
  166. procedure TFontForm.ResetButtonClick(Sender: TObject);
  167. begin
  168. FontName := InitialFontName;
  169. FontSize := InitialFontSize;
  170. FontColor := InitialFontColor;
  171. HotSpotColor := InitialHotSpotColor;
  172. Background := InitialBackground;
  173. end;
  174.  
  175. procedure TFontForm.HotSpotColorGridChange(Sender: TObject);
  176. begin
  177. HotSpotColor := HotSpotColorGrid.ForegroundColor;
  178. end;
  179.  
  180. procedure TFontForm.FontColorGridChange(Sender: TObject);
  181. begin
  182. FontColor := FontColorGrid.ForegroundColor;
  183. end;
  184.  
  185. procedure TFontForm.ListBoxClicks(Sender: TObject);
  186. begin
  187. if Sender = FontListBox then
  188.   FontName := FontListBox.Items[FontListBox.ItemIndex]
  189. else if Sender = BackListBox then
  190.   Background := StringToColor(BackListBox.Items[BackListBox.ItemIndex])
  191. else if Sender = FontSizeEdit then
  192.   FontSize := FontSizeEdit.Value;
  193. end;
  194.  
  195. end.
  196.